#include "f2c.h"
#include "blaswrap.h"

/* Table of constant values */

static integer c__4 = 4;
static integer c__8 = 8;
static integer c__1 = 1;

/* Subroutine */ int slarot_(logical *lrows, logical *lleft, logical *lright, 
	integer *nl, real *c__, real *s, real *a, integer *lda, real *xleft, 
	real *xright)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer ix, iy, nt;
    real xt[2], yt[2];
    integer iyt, iinc;
    extern /* Subroutine */ int srot_(integer *, real *, integer *, real *, 
	    integer *, real *, real *);
    integer inext;
    extern /* Subroutine */ int xerbla_(char *, integer *);


/*  -- LAPACK auxiliary test routine (version 3.1) -- */
/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/*     November 2006 */

/*     .. Scalar Arguments .. */
/*     .. */
/*     .. Array Arguments .. */
/*     .. */

/*  Purpose */
/*  ======= */

/*     SLAROT applies a (Givens) rotation to two adjacent rows or */
/*     columns, where one element of the first and/or last column/row */
/*     November 2006 */
/*     for use on matrices stored in some format other than GE, so */
/*     that elements of the matrix may be used or modified for which */
/*     no array element is provided. */

/*     One example is a symmetric matrix in SB format (bandwidth=4), for */
/*     which UPLO='L':  Two adjacent rows will have the format: */

/*     row j:     *  *  *  *  *  .  .  .  . */
/*     row j+1:      *  *  *  *  *  .  .  .  . */

/*     '*' indicates elements for which storage is provided, */
/*     '.' indicates elements for which no storage is provided, but */
/*     are not necessarily zero; their values are determined by */
/*     symmetry.  ' ' indicates elements which are necessarily zero, */
/*      and have no storage provided. */

/*     Those columns which have two '*'s can be handled by SROT. */
/*     Those columns which have no '*'s can be ignored, since as long */
/*     as the Givens rotations are carefully applied to preserve */
/*     symmetry, their values are determined. */
/*     Those columns which have one '*' have to be handled separately, */
/*     by using separate variables "p" and "q": */

/*     row j:     *  *  *  *  *  p  .  .  . */
/*     row j+1:   q  *  *  *  *  *  .  .  .  . */

/*     The element p would have to be set correctly, then that column */
/*     is rotated, setting p to its new value.  The next call to */
/*     SLAROT would rotate columns j and j+1, using p, and restore */
/*     symmetry.  The element q would start out being zero, and be */
/*     made non-zero by the rotation.  Later, rotations would presumably */
/*     be chosen to zero q out. */

/*     Typical Calling Sequences: rotating the i-th and (i+1)-st rows. */
/*     ------- ------- --------- */

/*       General dense matrix: */

/*               CALL SLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S, */
/*                       A(i,1),LDA, DUMMY, DUMMY) */

/*       General banded matrix in GB format: */

/*               j = MAX(1, i-KL ) */
/*               NL = MIN( N, i+KU+1 ) + 1-j */
/*               CALL SLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S, */
/*                       A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT ) */

/*               [ note that i+1-j is just MIN(i,KL+1) ] */

/*       Symmetric banded matrix in SY format, bandwidth K, */
/*       lower triangle only: */

/*               j = MAX(1, i-K ) */
/*               NL = MIN( K+1, i ) + 1 */
/*               CALL SLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S, */
/*                       A(i,j), LDA, XLEFT, XRIGHT ) */

/*       Same, but upper triangle only: */

/*               NL = MIN( K+1, N-i ) + 1 */
/*               CALL SLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S, */
/*                       A(i,i), LDA, XLEFT, XRIGHT ) */

/*       Symmetric banded matrix in SB format, bandwidth K, */
/*       lower triangle only: */

/*               [ same as for SY, except:] */
/*                   . . . . */
/*                       A(i+1-j,j), LDA-1, XLEFT, XRIGHT ) */

/*               [ note that i+1-j is just MIN(i,K+1) ] */

/*       Same, but upper triangle only: */
/*                    . . . */
/*                       A(K+1,i), LDA-1, XLEFT, XRIGHT ) */

/*       Rotating columns is just the transpose of rotating rows, except */
/*       for GB and SB: (rotating columns i and i+1) */

/*       GB: */
/*               j = MAX(1, i-KU ) */
/*               NL = MIN( N, i+KL+1 ) + 1-j */
/*               CALL SLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S, */
/*                       A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM ) */

/*               [note that KU+j+1-i is just MAX(1,KU+2-i)] */

/*       SB: (upper triangle) */

/*                    . . . . . . */
/*                       A(K+j+1-i,i),LDA-1, XTOP, XBOTTM ) */

/*       SB: (lower triangle) */

/*                    . . . . . . */
/*                       A(1,i),LDA-1, XTOP, XBOTTM ) */

/*  Arguments */
/*  ========= */

/*  LROWS  - LOGICAL */
/*           If .TRUE., then SLAROT will rotate two rows.  If .FALSE., */
/*           then it will rotate two columns. */
/*           Not modified. */

/*  LLEFT  - LOGICAL */
/*           If .TRUE., then XLEFT will be used instead of the */
/*           corresponding element of A for the first element in the */
/*           second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) */
/*           If .FALSE., then the corresponding element of A will be */
/*           used. */
/*           Not modified. */

/*  LRIGHT - LOGICAL */
/*           If .TRUE., then XRIGHT will be used instead of the */
/*           corresponding element of A for the last element in the */
/*           first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If */
/*           .FALSE., then the corresponding element of A will be used. */
/*           Not modified. */

/*  NL     - INTEGER */
/*           The length of the rows (if LROWS=.TRUE.) or columns (if */
/*           LROWS=.FALSE.) to be rotated.  If XLEFT and/or XRIGHT are */
/*           used, the columns/rows they are in should be included in */
/*           NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at */
/*           least 2.  The number of rows/columns to be rotated */
/*           exclusive of those involving XLEFT and/or XRIGHT may */
/*           not be negative, i.e., NL minus how many of LLEFT and */
/*           LRIGHT are .TRUE. must be at least zero; if not, XERBLA */
/*           will be called. */
/*           Not modified. */

/*  C, S   - REAL */
/*           Specify the Givens rotation to be applied.  If LROWS is */
/*           true, then the matrix ( c  s ) */
/*                                 (-s  c )  is applied from the left; */
/*           if false, then the transpose thereof is applied from the */
/*           right.  For a Givens rotation, C**2 + S**2 should be 1, */
/*           but this is not checked. */
/*           Not modified. */

/*  A      - REAL array. */
/*           The array containing the rows/columns to be rotated.  The */
/*           first element of A should be the upper left element to */
/*           be rotated. */
/*           Read and modified. */

/*  LDA    - INTEGER */
/*           The "effective" leading dimension of A.  If A contains */
/*           a matrix stored in GE or SY format, then this is just */
/*           the leading dimension of A as dimensioned in the calling */
/*           routine.  If A contains a matrix stored in band (GB or SB) */
/*           format, then this should be *one less* than the leading */
/*           dimension used in the calling routine.  Thus, if */
/*           A were dimensioned A(LDA,*) in SLAROT, then A(1,j) would */
/*           be the j-th element in the first of the two rows */
/*           to be rotated, and A(2,j) would be the j-th in the second, */
/*           regardless of how the array may be stored in the calling */
/*           routine.  [A cannot, however, actually be dimensioned thus, */
/*           since for band format, the row number may exceed LDA, which */
/*           is not legal FORTRAN.] */
/*           If LROWS=.TRUE., then LDA must be at least 1, otherwise */
/*           it must be at least NL minus the number of .TRUE. values */
/*           in XLEFT and XRIGHT. */
/*           Not modified. */

/*  XLEFT  - REAL */
/*           If LLEFT is .TRUE., then XLEFT will be used and modified */
/*           instead of A(2,1) (if LROWS=.TRUE.) or A(1,2) */
/*           (if LROWS=.FALSE.). */
/*           Read and modified. */

/*  XRIGHT - REAL */
/*           If LRIGHT is .TRUE., then XRIGHT will be used and modified */
/*           instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1) */
/*           (if LROWS=.FALSE.). */
/*           Read and modified. */

/*  ===================================================================== */

/*     .. Local Scalars .. */
/*     .. */
/*     .. Local Arrays .. */
/*     .. */
/*     .. External Subroutines .. */
/*     .. */
/*     .. Executable Statements .. */

/*     Set up indices, arrays for ends */

    /* Parameter adjustments */
    --a;

    /* Function Body */
    if (*lrows) {
	iinc = *lda;
	inext = 1;
    } else {
	iinc = 1;
	inext = *lda;
    }

    if (*lleft) {
	nt = 1;
	ix = iinc + 1;
	iy = *lda + 2;
	xt[0] = a[1];
	yt[0] = *xleft;
    } else {
	nt = 0;
	ix = 1;
	iy = inext + 1;
    }

    if (*lright) {
	iyt = inext + 1 + (*nl - 1) * iinc;
	++nt;
	xt[nt - 1] = *xright;
	yt[nt - 1] = a[iyt];
    }

/*     Check for errors */

    if (*nl < nt) {
	xerbla_("SLAROT", &c__4);
	return 0;
    }
    if (*lda <= 0 || ! (*lrows) && *lda < *nl - nt) {
	xerbla_("SLAROT", &c__8);
	return 0;
    }

/*     Rotate */

    i__1 = *nl - nt;
    srot_(&i__1, &a[ix], &iinc, &a[iy], &iinc, c__, s);
    srot_(&nt, xt, &c__1, yt, &c__1, c__, s);

/*     Stuff values back into XLEFT, XRIGHT, etc. */

    if (*lleft) {
	a[1] = xt[0];
	*xleft = yt[0];
    }

    if (*lright) {
	*xright = xt[nt - 1];
	a[iyt] = yt[nt - 1];
    }

    return 0;

/*     End of SLAROT */

} /* slarot_ */
